home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / CHEBFT.DEM < prev    next >
Text File  |  1991-04-29  |  1KB  |  56 lines

  1. PROGRAM d5r4(input,output);
  2. (* driver for routine CHEBFT *)
  3. LABEL 10,99;
  4. CONST
  5.    nval=40;
  6.    pio2=1.5707963;
  7.    eqs=1.0e-6;
  8. TYPE
  9.    glcarray=ARRAY [1..nval] OF real;
  10. VAR
  11.    a,b,dum,f : real;
  12.    t0,t1,term,x,y : real;
  13.    i,j,mval : integer;
  14.    c : glcarray;
  15.  
  16. FUNCTION func(x: real): real;
  17. BEGIN
  18.    func := sqr(x)*(sqr(x)-2.0)*sin(x)
  19. END;
  20.  
  21. (*$I MODFILE.PAS *)
  22. (*$I CHEBFT.PAS *)
  23.  
  24. BEGIN
  25.    a := -pio2;
  26.    b := pio2;
  27.    chebft(a,b,c,nval);
  28. (* test result *)
  29. 10:   writeln;
  30.    writeln('How many terms in Chebyshev evaluation?');
  31.    write('Enter n between 6 and ',nval:2,
  32.          '. (n := 0 to end).  ');
  33.    readln(mval);
  34.    IF ((mval <= 0) OR (mval > nval)) THEN GOTO 99;
  35.    writeln;
  36.    writeln('x':9,'actual':14,'chebyshev fit':16);
  37.    FOR i := -8 to 8 DO BEGIN
  38.       x := i*pio2/10.0;
  39.       y := (x-0.5*(b+a))/(0.5*(b-a));
  40. (* evaluate chebyshev polynomial without using routine chebev *);
  41.       t0 := 1.0;
  42.       t1 := y;
  43.       f := c[2]*t1+c[1]*0.5;
  44.       FOR j := 3 to mval DO BEGIN
  45.          dum := t1;
  46.          t1 := 2.0*y*t1-t0;
  47.          t0 := dum;
  48.          term := c[j]*t1;
  49.          f := f+term
  50.       END;
  51.       writeln(x:12:6,func(x):12:6,f:12:6)
  52.    END;
  53.    GOTO 10;
  54. 99:
  55. END.
  56.